home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 1995 #5 & #6 / Amiga Plus CD - 1995 - No. 5 and 6.iso / pd / serien / purity / nr.43 / os2unit / os2unit.p < prev    next >
Text File  |  1995-01-07  |  11KB  |  401 lines
  1. { ****** Auto-Revision (do NOT edit) ********************
  2.   *
  3.   * © Copyright by BOMBERSOFT
  4.   *
  5.   * Filename          : Sources:OS2Unit.p
  6.   * Created on        : 17-Dez-94  um 13:50:32 Uhr.
  7.   * Created by        : Björn Schotte
  8.   * Current revision  : V0.030
  9.   *
  10.   *
  11.   * Purpose: Unit zur Vereinfachung von OS2-Sachen, z.B. GUIs etc.
  12.   *
  13.   *
  14.   * V0.030 kreiert am 17-Dez-94  um 13:50:32 Uhr. LogMessage:
  15.   *        ASLFileReq() hinzugefügt. Mächtige Funktion 
  16.   *        zum Auswählen von Dateien.
  17.   *
  18.   * V0.020 kreiert am 11-Dez-94  um 15:38:36 Uhr. LogMessage:
  19.   *        SetXXXGad-Prozeduren erweitert; 
  20.   *        GhostGadget(), GadSelect hinzugefügt.
  21.   *
  22.   * V0.010 kreiert am 11-Dez-94  um 12:10:04 Uhr. LogMessage:
  23.   *        SetXXXGad-Prozeduren hinzugefügt.
  24.   *
  25.   * V0.000 kreiert am 11-Dez-94  um 11:32:24 Uhr. LogMessage:
  26.   *        --- Initial release ---
  27.   ******************************************************* }
  28.  
  29. UNIT OS2;
  30.  
  31. INTERFACE
  32.  
  33. USES Intuition, Exec;
  34.  
  35. {$incl "gadtools.lib",
  36.         "graphics/text.h",
  37.          "asl.lib",
  38.          "dos.lib"}
  39.  
  40. CONST
  41.   FREQ_NOTALLOC = -100;
  42.         
  43. TYPE
  44.   p_ASLFileStruct = ^ASLFileStruct;
  45.   ASLFileStruct = RECORD
  46.      left, top,
  47.       width,
  48.       height     : INTEGER;
  49.      titel      : STRING[80];
  50.       pfad,
  51.       datei,
  52.       initp,
  53.       initd,
  54.       filename   : STRING[256];
  55.       pattern    : STRING[80];
  56.       display_pat: BOOLEAN;
  57.       win        : p_Window;
  58.       winsleep,
  59.       canceled   : BOOLEAN;
  60.       negativ,
  61.       positiv    : STRING;
  62.   END;
  63.  
  64. VAR
  65.   topaz80                        : TextAttr;
  66.   MyTattr                  : ^TextAttr;
  67.   WBRight, WBBottom,
  68.   ScreenW, ScreenH, FontX,
  69.   FontY, XOff, YOff        : LONG;
  70.   
  71. FUNCTION OpenGadTools(version:INTEGER) : BOOLEAN;
  72. FUNCTION OpenASL(version:INTEGER) : BOOLEAN;
  73. PROCEDURE CloseGadTools;
  74. PROCEDURE CloseASL;
  75.  
  76. FUNCTION ComputeX(value:INTEGER) : INTEGER;
  77. FUNCTION ComputeY(value:INTEGER) : INTEGER;
  78. PROCEDURE ComputeFont(VAR f        : p_TextFont;
  79.                       width,height : INTEGER);
  80. PROCEDURE SensitivGadget(VAR ng:NewGadget);
  81. PROCEDURE FS_BevelBox(VAR wo   : p_Window;
  82.                       VAR vi   : PTR;
  83.                              x,y,b,h  : INTEGER;
  84.                              recessed : BOOLEAN);
  85. PROCEDURE GadSelect(VAR wp:p_Window; VAR gad:p_Gadget);
  86. PROCEDURE SetCheckBox(VAR wp:p_Window; VAR gad:p_Gadget; req:p_Requester;
  87.                       flag:BOOLEAN);                             
  88. PROCEDURE SetMXGad(VAR wp:p_Window; VAR gad:p_Gadget; req:p_Requester;
  89.                    active:LONG);                              
  90. PROCEDURE SetCycleGad(VAR wp:p_Window; VAR gad:p_Gadget; req:p_Requester;
  91.                       active:LONG);                              
  92. PROCEDURE SetListViewGad(VAR wp:p_Window; VAR gad:p_Gadget; req:p_Requester;
  93.                          active,top:LONG);                              
  94. PROCEDURE SetListViewList(VAR wp:p_Window; VAR gad:p_Gadget; req:p_Requester;
  95.                           VAR NeueList : p_List);                              
  96. PROCEDURE SetNumberGad(VAR wp:p_Window; VAR gad:p_Gadget; req:p_Requester;
  97.                           nummer:LONG);                              
  98. PROCEDURE GhostGadget(VAR wp:p_Window; VAR gad:p_Gadget; req:p_Requester;
  99.                       dis:BOOLEAN);                              
  100. PROCEDURE ActStringGad(VAR wp:p_Window; VAR gad:p_Gadget; req:p_Requester);
  101. PROCEDURE InitASLStruct(VAR asls : ASLFileStruct);
  102. FUNCTION ASLFileReq(VAR ASLStruct : ASLFileStruct) : LONG;
  103.  
  104. IMPLEMENTATION
  105.  
  106. { Versucht, die "gadtools.library" mit der angegebenen Versionsnummer 
  107.   zu öffnen.                                                      
  108.   
  109.   Eingabe: Mind.-Version
  110.   Ausgabe: TRUE bei Erfolg, ansonsten FALSE                            }
  111. FUNCTION OpenGadTools;
  112. BEGIN
  113.   OpenGadTools := FALSE;
  114.   GadToolsBase := OpenLibrary("gadtools.library", version);
  115.   IF GadToolsBase <> NIL THEN OpenGadTools := TRUE;
  116. END;
  117.  
  118. FUNCTION OpenASL;
  119. BEGIN
  120.   OpenASL := FALSE;
  121.   ASLBase := OpenLibrary("asl.library", version);
  122.   IF ASLBase <> NIL THEN OpenASL := TRUE;
  123. END;
  124.  
  125. { Schliesst die "gadtools.library" }
  126. PROCEDURE CloseGadTools;
  127. BEGIN
  128.   IF GadToolsBase <> NIL THEN CloseLibrary(GadToolsBase);
  129.   GadToolsBase := NIL;
  130. END;
  131.  
  132. PROCEDURE CloseASL;
  133. BEGIN
  134.   IF ASLBase <> NIL THEN CloseLibrary(ASLBase);
  135.   ASLBase := NIL;
  136. END;
  137.  
  138. { Eingabe: Breite bei topaz/8-Font   }
  139. { Ausgabe: Breite bei aktuellem Font }
  140. FUNCTION ComputeX;
  141. BEGIN
  142.   ComputeX := ((FontX * value)+4) DIV 8;
  143. END;
  144.  
  145. { Eingabe: Höhe bei topaz/8-Font   }
  146. { Ausgabe: Höhe bei aktuellem Font }
  147. FUNCTION ComputeY;
  148. BEGIN
  149.   ComputeY := ((FontY*value)+4) DIV 8;
  150. END;
  151.  
  152. PROCEDURE ComputeFont;
  153. LABEL UseTopaz;
  154. BEGIN
  155.   Forbid;
  156.   MyTattr := ^topaz80;
  157.   MyTattr^.ta_Name := f^.tf_Message.mn_Node.ln_Name;
  158.   MyTattr^.ta_YSize := f^.tf_YSize;
  159.   FontY := f^.tf_YSize;
  160.   FontX := f^.tf_XSize;
  161.   Permit;
  162.   IF (width>0) AND (height>0) THEN
  163.   BEGIN
  164.     IF ( (ComputeX(width)+xoff+WBRight)>ScreenW) THEN GOTO UseTopaz;
  165.     IF ( (ComputeY(height)+yoff+WBBottom)>ScreenH) THEN GOTO UseTopaz;
  166.   END;
  167.   EXIT;
  168. UseTopaz:
  169.   MyTattr^.ta_Name := "topaz.font";
  170.   FontX := 8;
  171.   FontY := 8;
  172.   MyTattr^.ta_Flags := FPF_ROMFONT;
  173.   MyTattr^.ta_YSize := 8;
  174. END;
  175.  
  176. { Modifiziert die Koordinaten eines Gadgets so, daß }
  177. {  sie sich fontsensitiv anpassen.                  }
  178. PROCEDURE SensitivGadget;
  179. BEGIN
  180.   ng.ng_LeftEdge := ComputeX(ng.ng_LeftEdge)+xoff;
  181.   ng.ng_TopEdge  := ComputeY(ng.ng_TopEdge)+yoff;
  182.   ng.ng_Width    := ComputeX(ng.ng_Width);
  183.   ng.ng_Height   := ComputeY(ng.ng_Height);
  184. END;
  185.  
  186. { Zeichnet eine (fontsensitive) BevelBox }
  187. PROCEDURE FS_BevelBox;
  188. VAR
  189.   t : ARRAY[1..3] OF TagItem;
  190. BEGIN
  191.   t[1] := TagItem(GT_VisualInfo,LONG(vi));
  192.   t[2] := TagItem(GTBB_Recessed, LONG(recessed));
  193.   t[3].ti_Tag := TAG_DONE;
  194.  
  195.   DrawBevelBoxA(wo^.RPort,
  196.                 xoff+ComputeX(x),
  197.                 yoff+ComputeY(y),
  198.                      ComputeX(b),
  199.                      ComputeY(h),
  200.                      ^t);
  201. END;
  202.  
  203. { Nützliches Feature: Bei gadtools-Gadgets kann man per
  204.   GT_Underscore einen Buchstaben im Gadget-Text unter-
  205.   streichen. Dies soll ja bekanntlich signalisieren,
  206.   daß man durch Drücken dieses unterstrichenen Buchsta-
  207.   bens das Gadget auswählen kann. Um dies "sichtbar" zu
  208.   machen, sollte das Gadget beim Drücken der Taste inver-
  209.   tiert werden, und beim Loslassen wieder im "normalen"
  210.   Zustand gebracht werden.
  211.   
  212.   Eingabe: Das Fenster, wo es selektiert werden soll und
  213.            das Gadget (logisch !)                           }
  214. PROCEDURE GadSelect;
  215. VAR
  216.   next        : p_Gadget;
  217.   old         : LONG;
  218.   dummy       : BOOLEAN;
  219.   class, code : LONG;
  220.   msg         : p_IntuiMessage;
  221. BEGIN
  222.   old := wp^.IDCMPFlags;
  223.   dummy:=ModifyIDCMP(wp,IDCMP_RAWKEY);
  224.   next := gad^.NextGadget;
  225.   gad^.NextGadget := NIL;
  226.   gad^.Flags := gad^.Flags + SELECTED;
  227.   RefreshGadgets(gad,wp,NIL);
  228.   REPEAT
  229.     msg := p_IntuiMessage(WaitPort(wp^.UserPort));
  230.      msg := GT_GetIMsg(wp^.UserPort);
  231.      class := msg^.Class;
  232.      code  := msg^.Code;
  233.      GT_ReplyIMsg(msg);
  234.   UNTIL (class = IDCMP_RAWKEY) AND ( (code AND IECODE_UP_PREFIX)=IECODE_UP_PREFIX);
  235.   dummy:=ModifyIDCMP(wp,old);
  236.   gad^.Flags := gad^.Flags - SELECTED;
  237.   RefreshGadgets(gad,wp,NIL);
  238.   gad^.NextGadget := next;
  239. END;
  240.  
  241. { CheckBox-Gadget an- bzw. ausschalten.
  242.     
  243.   Eingabe: Fenster, das Gadget und - wenn nötig - der
  244.            Requester, auf dem das Gadget "liegt"      }
  245. PROCEDURE SetCheckBox;
  246. VAR
  247.   t : ARRAY[1..2] OF TagItem;
  248. BEGIN
  249.   t[1] := TagItem(GTCB_Checked, ORD(flag));
  250.   t[2].ti_Tag := TAG_DONE;
  251.   GT_SetGadgetAttrsA(gad, wp, req, ^t);
  252. END;
  253.  
  254. PROCEDURE SetMXGad;
  255. VAR
  256.   t : ARRAY[1..2] OF TagItem;
  257. BEGIN
  258.   t[1] := TagItem(GTMX_Active, active);
  259.   t[2].ti_Tag := TAG_DONE;
  260.   GT_SetGadgetAttrsA(gad,wp,req,^t);
  261. END;
  262.  
  263. PROCEDURE SetCycleGad;
  264. VAR
  265.   t : ARRAY[1..2] OF TagItem;
  266. BEGIN
  267.   t[1] := TagItem(GTCY_Active, active);
  268.   t[2].ti_Tag := TAG_DONE;
  269.   GT_SetGadgetAttrsA(gad,wp,req,^t);
  270. END;
  271.  
  272. PROCEDURE SetListViewGad;
  273. VAR
  274.   t : ARRAY[1..3] OF TagItem;
  275. BEGIN
  276.   t[1] := TagItem(GTLV_Selected, active);
  277.   t[2] := TagItem(GTLV_Top, top);
  278.   t[3].ti_Tag := TAG_DONE;
  279.   GT_SetGadgetAttrsA(gad,wp,req,^t);
  280. END;
  281.  
  282. PROCEDURE SetListViewList;
  283. VAR
  284.   t : ARRAY[1..2] OF TagItem;
  285. BEGIN
  286.   t[1] := TagItem(GTLV_Labels, LONG(NeueList));
  287.   t[2].ti_Tag := TAG_DONE;
  288.   GT_SetGadgetAttrsA(gad,wp,req,^t);
  289. END;
  290.  
  291. PROCEDURE SetNumberGad;
  292. VAR
  293.   t : ARRAY[1..2] OF TagItem;
  294. BEGIN
  295.   t[1] := TagItem(GTNM_Number, nummer);
  296.   t[2].ti_Tag := TAG_DONE;
  297.   GT_SetGadgetAttrsA(gad,wp,req,^t);
  298. END;
  299.  
  300. PROCEDURE GhostGadget;
  301. VAR
  302.   t : ARRAY[1..2] OF TagItem;
  303. BEGIN
  304.   t[1] := TagItem(GA_Disabled, ORD(dis));
  305.   t[2].ti_Tag := TAG_DONE;
  306.   GT_SetGadgetAttrsA(gad,wp,req,^t);
  307. END;
  308.  
  309. PROCEDURE ActStringGad;
  310. VAR
  311.   dummy : BOOLEAN;
  312. BEGIN
  313.   dummy := ActivateGadget(gad,wp,req);
  314. END;
  315.  
  316. PROCEDURE InitASLStruct;
  317. BEGIN
  318.   asls := ASLFileStruct(-1,-1,-1,-1,"","","","","","","",TRUE,NIL,FALSE,FALSE,
  319.                         "","");
  320. END;
  321.  
  322. FUNCTION ASLFileReq;
  323. VAR
  324.   t : ARRAY[0..12] OF TagItem;
  325.   fre : p_FileRequester;
  326.   bool : BOOLEAN;
  327. BEGIN
  328.   ASLFileReq := 0;
  329.   t[0].ti_Tag := ASLFR_InitialDrawer;
  330.   IF ASLStruct.initp <> "" THEN t[0].ti_Data := LONG(^ASLStruct.initp)
  331.                            ELSE t[0].ti_Tag := TAG_IGNORE;
  332.   t[1].ti_Tag := ASLFR_InitialFile;
  333.   IF ASLStruct.initd <> "" THEN t[1].ti_Data := LONG(^ASLStruct.initd)
  334.                            ELSE t[1].ti_Tag := TAG_IGNORE;
  335.   t[2] := TagItem(ASLFR_Window, LONG(ASLStruct.win));
  336.   IF ASLStruct.win <> NIL THEN t[2] := TagItem(ASLFR_SleepWindow, ORD(ASLStruct.winsleep))
  337.                           ELSE t[2].ti_Tag := TAG_IGNORE;
  338.   t[3] := TagItem(ASLFR_TitleText, LONG(^ASLStruct.titel));
  339.   IF ASLStruct.pattern <> "" THEN
  340.   BEGIN
  341.     t[4] := TagItem(ASLFR_InitialPattern, LONG(^ASLStruct.pattern))
  342.   END ELSE
  343.   BEGIN
  344.     t[4].ti_Tag := TAG_IGNORE;                    
  345.   END;
  346.   IF ASLStruct.display_pat THEN
  347.      t[5] := TagItem(ASLFR_DoPatterns, ORD(TRUE))
  348.   ELSE
  349.      t[5].ti_Tag := TAG_IGNORE;          
  350.      
  351.   IF ASLStruct.left > -1 THEN t[6] := TagItem(ASLFR_InitialLeftEdge, ASLStruct.left)
  352.                          ELSE t[6].ti_Tag := TAG_IGNORE;
  353.   IF ASLStruct.top > -1 THEN t[7] := TagItem(ASLFR_InitialTopEdge, ASLStruct.top)
  354.                          ELSE t[7].ti_Tag := TAG_IGNORE;
  355.   IF ASLStruct.width > -1 THEN t[8] := TagItem(ASLFR_InitialWidth, ASLStruct.width)
  356.                          ELSE t[8].ti_Tag := TAG_IGNORE;
  357.   IF ASLStruct.height > -1 THEN t[9] := TagItem(ASLFR_InitialHeight, ASLStruct.height)
  358.                          ELSE t[9].ti_Tag := TAG_IGNORE;
  359.                                  
  360.   IF ASLStruct.negativ <> "" THEN
  361.     t[10] := TagItem(ASLFR_NegativeText, LONG(^ASLStruct.negativ))
  362.   ELSE
  363.     t[10].ti_Tag := TAG_IGNORE;
  364.  
  365.   IF ASLStruct.positiv <> "" THEN
  366.     t[11] := TagItem(ASLFR_PositiveText, LONG(^ASLStruct.positiv))
  367.   ELSE
  368.     t[11].ti_Tag := TAG_IGNORE;
  369.      
  370.   t[12].ti_Tag := TAG_DONE;
  371.   
  372.   fre := AllocASLRequest(ASL_FileRequest, ^t);
  373.   IF fre <> NIL THEN
  374.   BEGIN
  375.      IF ASLRequest(fre, ^t) THEN
  376.      BEGIN
  377.        ASLStruct.pfad := fre^.rf_Dir;
  378.         ASLStruct.datei := fre^.rf_File;
  379.         ASLStruct.canceled := FALSE;
  380.         ASLStruct.filename := ASLStruct.pfad;
  381.         bool := AddPart(ASLStruct.filename,ASLStruct.datei,256);
  382.         ASLStruct.pattern := fre^.rf_Pat;
  383.         ASLStruct.initp := ASLStruct.pfad;
  384.         ASLStruct.initd := ASLStruct.datei;
  385.      END ELSE
  386.      BEGIN
  387.         IF IOErr = 0 THEN ASLStruct.canceled := TRUE
  388.         ELSE
  389.         BEGIN
  390.           ASLStruct.canceled := FALSE;
  391.           ASLFileReq := IOErr;
  392.         END;
  393.     END;
  394.      FreeASLRequest(fre);
  395.   END ELSE ASLFileReq := FREQ_NOTALLOC;
  396. END;
  397.  
  398. BEGIN
  399.   topaz80 := TextAttr("topaz.font", 8, 0, 0);
  400. END.
  401.